home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 031a / bankma.zip / BANKACC.PAS next >
Pascal/Delphi Source File  |  1991-08-19  |  16KB  |  580 lines
  1. { ----------------------------------------------------------------------- }
  2. { Source file: BANKACC.PAS                                                }
  3. { Application: Bank Manager                                               }
  4. { Version    : 1.0                                                        }
  5. { Created    : 08/19/91                                                   }
  6. { Updates    :                                                            }
  7. {                                                                         }
  8. { Description: Maintain bank account data files.                          }
  9. {              Account number, type, current balance, bank name and       }
  10. {              current check number (if checking account!!)               }
  11. { Notes      :                                                            }
  12. { ----------------------------------------------------------------------- }
  13. unit BankAcc;
  14.  
  15. {$R BANKACC.RES}
  16.  
  17. interface
  18.  
  19. uses Strings, WinTypes, WinProcs, WinDos, WObjects;
  20.  
  21. const
  22.   AccFile   = 'BANKACC.DTA';
  23.  
  24. type
  25.   PGetAcc   = ^TGetAcc;
  26.   TGetAcc   =
  27.     object( TDialog)
  28.       { Overridden methods }
  29.       procedure OK( var Msg: TMessage); virtual id_First + id_OK;
  30.       procedure SetupWindow; virtual;
  31.       { New methods }
  32.       function GetAccounts( T: PChar): boolean;
  33.       procedure Handle101( var Msg: TMessage); virtual id_First + 101;
  34.       procedure Handle102( var Msg: TMessage); virtual id_First + 102;
  35.       procedure Handle103( var Msg: TMessage); virtual id_First + 103;
  36.       procedure Handle105( var Msg: TMessage); virtual id_First + 105;
  37.       procedure Handle106( var Msg: TMessage); virtual id_First + 106;
  38.     end;
  39.  
  40.   PAcc = ^TAcc;
  41.   TAcc =
  42.     object( TDialog)
  43.       DialogN: array[0..20] of char;
  44.       NewFile,
  45.       NewRec : boolean;
  46.       OldPos,
  47.       RecPos : integer;
  48.       { Overridden methods}
  49.       constructor Init( AParent: PWindowsObject; AName: PChar);
  50.       function CanClose: boolean; virtual;
  51.       procedure SetupWindow; virtual;
  52.       procedure OK( var Msg: TMessage); virtual id_First + id_OK;
  53.       { New methods }
  54.       procedure FillAccTypes; virtual;
  55.       procedure FillFields; virtual;
  56.       function FindAccNum( T: Pchar): boolean; virtual;
  57.       procedure Handle101( var Msg: TMessage); virtual id_First + 101;
  58.     end;
  59.  
  60.     PAccBalance = ^TAccBalance;
  61.     TAccBalance =
  62.       object( TDialog)
  63.         constructor Init( AParent: PWindowsObject; ATitle: PChar);
  64.         procedure SetupWindow; virtual;
  65.         procedure SetupAccount; virtual;
  66.         procedure SetMonthButton( M: integer); virtual;
  67.         function GetBalance( T: PChar): real; virtual;
  68.         procedure Handle105( var Msg: TMessage); virtual id_First + 105;
  69.       end;
  70. var
  71.   GAccNum : array[0..20] of char;
  72.   GMulti  : boolean;
  73.   GAccType: array[0..12] of char;
  74.  
  75. implementation
  76.  
  77. const
  78.   Month: array[1..12] of string[9] = ( 'January', 'February', 'March', 'April',
  79.                                        'May', 'June', 'July', 'August', 'September',
  80.                                        'October', 'November', 'December');
  81. type
  82.   AccRec =
  83.     record
  84.       AccType : array[0..12] of char;
  85.       AccNum  : array[0..20] of char;
  86.       AccBal  : real;
  87.       AccBank : array[0..18] of char;
  88.       AccCheck: integer;
  89.     end;
  90.  
  91.   ActRec =
  92.     record
  93.       AccNum : array[0..20] of char;
  94.       Trans  : array[0..31] of char;
  95.       Credit : real;
  96.       Debit  : real;
  97.       Balance: real;
  98.       Check  : integer;
  99.       Date   : array[0..9] of char;
  100.       Notes  : array[0..66] of char;
  101.     end;
  102.  
  103. var
  104.    GAccRec : AccRec;
  105.    GActRec : ActRec;
  106.    AccF    : file of AccRec;
  107.    ActF    : file of ActRec;
  108.    NewA,
  109.    OldA    : boolean;
  110.    PStr    : string[20];
  111.    GYearN,
  112.    GMonthN : word;
  113.    GoBack  : boolean;
  114.  
  115. {--------------------------------------------------}
  116. { TGetAcc's method implementations:                }
  117. {--------------------------------------------------}
  118.  
  119. { Overridden methods }
  120.  
  121. procedure TGetAcc.SetupWindow;
  122. begin
  123.   assign( AccF, AccFile);
  124.   {$I-}
  125.   reset( AccF);
  126.   {$I+}
  127.   if ioresult <> 0 then
  128.   begin
  129.     MessageBox( HWindow, 'You must create an account first',
  130.                 'Account Manager', mb_IconInformation or mb_OK);
  131.     EndDialog( HWindow, id_Cancel);
  132.   end;
  133.   close( AccF);
  134. end;
  135.  
  136. procedure TGetAcc.OK( var Msg: TMessage);
  137. begin
  138.   if TDialog.CanClose then
  139.   begin
  140.     GetDlgItemText( HWindow, 104, GAccNum, 20);
  141.     if StrLen( GAccNum) = 0 then EndDialog( HWindow, id_Cancel)
  142.     else EndDialog( HWindow, id_OK);
  143.   end;
  144. end;
  145.  
  146. function TGetAcc.GetAccounts( T: PChar): boolean;
  147. var
  148.   AccT: array[0..18] of char;
  149.   Temp: PChar;
  150. begin
  151.   StrCopy( GAccType, T);
  152.   GetMem( Temp, 20);
  153.   StrCopy( AccT, T);
  154.   SendDlgItemMsg( 104, cb_ResetContent, 0, 0);
  155.   reset( AccF);
  156.   repeat
  157.     read( AccF, GAccRec);
  158.     if StrComp( AccT, GAccRec.AccType) = 0 then
  159.     begin
  160.       StrCopy( Temp, GAccRec.AccNum);
  161.       SendDlgItemMsg( 104, cb_AddString, 0, longint( Temp));
  162.     end;
  163.   until FilePos( AccF) = FileSize( AccF);
  164.   if SendDlgItemMsg( 104, cb_GetCount, 0, 0) = 0 then
  165.   begin
  166.     GetAccounts := FALSE;
  167.     MessageBox( HWindow, 'You do not have any accounts of this type',
  168.                 'Open error', mb_IconStop or mb_OK);
  169.   end
  170.   else
  171.   begin
  172.     GetAccounts := TRUE;
  173.     SendDlgItemMsg( 104, cb_SetCurSel, 0, 0);
  174.   end;
  175.   close( AccF);
  176.   FreeMem( Temp, 20);
  177. end;
  178.  
  179. procedure TGetAcc.Handle101( var Msg: TMessage);
  180. begin
  181.   if SendDlgItemMsg( 101, bm_GetCheck, 0, 0) > 0 then
  182.     GetAccounts( 'Checking')
  183.   else
  184.     DefWndProc( Msg);
  185. end;
  186.  
  187. procedure TGetAcc.Handle102( var Msg: TMessage);
  188. begin
  189.   if SendDlgItemMsg( 102, bm_GetCheck, 0, 0) > 0 then
  190.     GetAccounts( 'Savings')
  191.   else
  192.     DefWndProc( Msg);
  193. end;
  194.  
  195. procedure TGetAcc.Handle103( var Msg: TMessage);
  196. begin
  197.   if SendDlgItemMsg( 103, bm_GetCheck, 0, 0) > 0 then
  198.     GetAccounts( 'Credit')
  199.   else
  200.     DefWndProc( Msg);
  201. end;
  202.  
  203. procedure TGetAcc.Handle105( var Msg: TMessage);
  204. begin
  205.   if SendDlgItemMsg( 105, bm_GetCheck, 0, 0) <> 0 then GMulti := TRUE
  206.   else GMulti := FALSE;
  207. end;
  208.  
  209. procedure TGetAcc.Handle106( var Msg: TMessage);
  210. begin
  211.   if SendDlgItemMsg( 106, bm_GetCheck, 0, 0) > 0 then
  212.     GetAccounts( 'Loan')
  213.   else
  214.     DefWndProc( Msg);
  215. end;
  216.  
  217. {--------------------------------------------------}
  218. { TCreateAcc's method implementations:             }
  219. {--------------------------------------------------}
  220.  
  221. { Overridden methods }
  222.  
  223. constructor TAcc.Init( AParent: PwindowsObject; AName: PChar);
  224. begin
  225.   TDialog.Init( AParent, AName);
  226.   StrCopy( DialogN, AName);
  227. end;
  228.  
  229. procedure TAcc.SetupWindow;
  230. begin
  231.   assign( AccF, AccFile);
  232.   {$I-}
  233.   reset( AccF);
  234.   {$I+}
  235.   if ioresult <> 0 then
  236.   begin
  237.     rewrite( AccF);
  238.     NewFile := TRUE;
  239.   end
  240.   else NewFile := FALSE;
  241.   close( AccF);
  242.  
  243.   { Fill combo box }
  244.   FillAccTypes;
  245.   { Fill fields with existing information }
  246.   if StrComp( DialogN, 'OLDACC') = 0 then FillFields;
  247. end;
  248.  
  249. function TAcc.CanClose: boolean;
  250. var
  251.   Index: word;
  252.   Temp : PChar;
  253.   PTmp : string[20];
  254.   Err  : integer;
  255.   TB   : boolean;
  256. begin
  257.   TB := TDialog.CanClose;
  258.   CanClose := TB;
  259.   if TB then
  260.   begin
  261.     GetMem( Temp, 20);
  262.     { Account number }
  263.     GetDlgItemText( HWindow, 101, GAccRec.AccNum, 20);
  264.     if StrLen( GAccRec.AccNum) = 0 then
  265.     begin
  266.       MessageBox( HWindow, 'Account number cannot be blank', 'Account Management',
  267.                   mb_IconInformation or mb_OK);
  268.       CanClose := FALSE;
  269.       FreeMem( Temp, 20);
  270.       exit;
  271.     end;
  272.     { Account type }
  273.     Index := SendDlgItemMsg( 102, cb_GetCurSel, 0, 0);
  274.     SendDlgItemMsg( 102, cb_GetLBText, Index, longint( Temp));
  275.     StrCopy( GAccRec.AccType, Temp);
  276.     { Account balance }
  277.     GetDlgItemText( HWindow, 103, Temp, 10);
  278.     PTmp := StrPas( Temp);
  279.     val( PTmp, GAccRec.AccBal, Err);
  280.     if Err <> 0 then
  281.     begin
  282.       MessageBox( HWindow, 'Invalid account balance', 'Account Management',
  283.                   mb_IconInformation or mb_OK);
  284.       CanClose := FALSE;
  285.       GAccRec.AccBal := 0.0;
  286.       FreeMem( Temp, 20);
  287.       Exit;
  288.     end;
  289.     { Account bank }
  290.     GetDlgItemText( HWindow, 104, GAccRec.AccBank, 20);
  291.     { Account starting check number }
  292.     if StrComp( GAccRec.AccType, 'Checking') = 0 then
  293.     begin
  294.       GetDlgItemText( HWindow, 105, Temp, 10);
  295.       PTmp := StrPas( Temp);
  296.       val( PTmp, GAccRec.AccCheck, Err);
  297.       if Err <> 0 then
  298.       begin
  299.         MessageBox( HWindow, 'Invalid starting check number', 'Account Management',
  300.                     mb_IconInformation or mb_OK);
  301.         CanClose := FALSE;
  302.         GAccRec.AccCheck := 0;
  303.         FreeMem( Temp, 20);
  304.         Exit;
  305.       end;
  306.     end;
  307.     FreeMem( Temp, 20);
  308.   end;
  309. end;
  310.  
  311. procedure TAcc.OK( var Msg: TMessage);
  312. begin
  313.   if CanClose then
  314.   begin
  315.     reset( AccF);
  316.     if not NewFile then
  317.     begin
  318.       if NewRec then System.Seek( AccF, FileSize( AccF))
  319.       else System.Seek( AccF, OldPos);
  320.     end;
  321.     write( AccF, GAccRec);
  322.     close( AccF);
  323.     EndDialog( HWindow, id_OK);
  324.   end;
  325. end;
  326.  
  327. { New methods }
  328.  
  329. procedure TAcc.FillAccTypes;
  330. var
  331.   cb_MyItem: PChar;
  332. begin
  333.   cb_MyItem := 'Checking';
  334.   SendDlgItemMsg( 102, cb_AddString, 0, longint( cb_MyItem));
  335.   cb_MyItem := 'Credit';
  336.   SendDlgItemMsg( 102, cb_AddString, 0, longint( cb_MyItem));
  337.   cb_MyItem := 'Savings';
  338.   SendDlgItemMsg( 102, cb_AddString, 0, longint( cb_MyItem));
  339.   cb_MyItem := 'Loan';
  340.   SendDlgItemMsg( 102, cb_AddString, 0, longint( cb_MyItem));
  341.   SendDlgItemMsg( 102, cb_SetCurSel, 0, 0);
  342. end;
  343.  
  344. procedure TAcc.FillFields;
  345. var
  346.   PC   : PChar;
  347.   Index: integer;
  348. begin
  349.   FindAccNum( GAccNum);
  350.   GetMem( PC, 20);
  351.   OldPos := RecPos;
  352.   SetDlgItemText( HWindow, 101, GAccNum);
  353.   NewRec := FALSE;
  354.   StrCopy( PC, GAccRec.AccType);
  355.   Index := SendDlgItemMsg( 102, cb_FindString, 0, longint( PC));
  356.   SendDlgItemMsg( 102, cb_SetCurSel, Index, 0);
  357.   str( GAccRec.AccBal:0:2, PStr);
  358.   StrPCopy( PC, PStr);
  359.   SetDlgItemText( HWindow, 103, PC);
  360.   SetDlgItemText( HWindow, 104, GAccRec.AccBank);
  361.   if StrComp( GAccRec.AccType, 'Checking') = 0 then
  362.   begin
  363.     str( GAccRec.AccCheck, PStr);
  364.     StrPCopy( PC, PStr);
  365.     SetDlgItemText( HWindow, 105, PC);
  366.   end
  367.   else
  368.     SetDlgItemText( HWindow, 105, PChar( 0));
  369.   FreeMem( PC, 20);
  370. end;
  371.  
  372. function TAcc.FindAccNum( T: PChar): boolean;
  373. begin
  374.   reset( AccF);
  375.   if not NewFile then
  376.   begin
  377.     System.Seek( AccF, 0);
  378.     repeat
  379.       read( AccF, GAccRec);
  380.     until ( FilePos( AccF) = FileSize( AccF)) or ( StrComp( T, GAccRec.AccNum) = 0);
  381.     if StrComp( T, GAccRec.AccNum) = 0 then
  382.     begin
  383.       RecPos := FilePos( AccF) - 1;
  384.       FindAccNum := TRUE;
  385.     end
  386.     else
  387.     begin
  388.       RecPos := FileSize( AccF) + 1;
  389.       FindAccNum := FALSE;
  390.     end;
  391.   end
  392.   else FindAccNum := FALSE;
  393.   close( AccF);
  394. end;
  395.  
  396. procedure TAcc.Handle101( var Msg: TMessage);
  397. var
  398.   MyItem : PChar;
  399.   TStr   : array[0..20] of char;
  400. begin
  401.   DefWndProc( Msg);
  402.   GetMem( MyItem, 20);
  403.   if Msg.LParamHi = en_KillFocus then
  404.   begin
  405.     GetDlgItemText( HWindow, 101, MyItem, 20);
  406.     StrCopy( TStr, MyItem);
  407.     if FindAccNum( MyItem) then
  408.     begin
  409.       if StrComp( DialogN, 'NEWACC') = 0 then
  410.       begin
  411.         MessageBox( HWindow, 'Account already exists', 'Account Manager',
  412.                     mb_IconInformation or mb_OK);
  413.         SetDlgItemText( HWindow, 101, PChar( 0));
  414.         FreeMem( MyItem, 20);
  415.         Exit;
  416.       end
  417.     end
  418.     else if StrLen( TStr) <> 0 then
  419.     begin
  420.       NewRec := FALSE;
  421.       if StrComp( DialogN, 'OLDACC') = 0 then
  422.       begin
  423.         if MessageBox( HWindow, 'Account number has changed. Save change?', 'Account Manager',
  424.                        mb_IconQuestion or mb_YesNo) = id_Yes then
  425.           RecPos := OldPos
  426.         else
  427.           SetDlgItemText( HWindow, 101, GAccNum);
  428.       end
  429.       else
  430.       begin
  431.         if MessageBox( HWindow, 'Account not found. Create a new one?', 'Account Manager',
  432.                        mb_IconQuestion or mb_YesNo) = idYes then NewRec := TRUE
  433.         else
  434.         begin
  435.           NewRec := FALSE;
  436.           SetDlgItemText( HWindow, 101, PChar( 0));
  437.         end;
  438.       end;
  439.     end;
  440.   end;
  441.   FreeMem( MyItem, 20);
  442. end;
  443.  
  444. {--------------------------------------------------}
  445. { TAccBalance's method implementations:            }
  446. {--------------------------------------------------}
  447.  
  448. { Overridden methods }
  449.  
  450. constructor TAccBalance.Init( AParent: PWindowsObject; ATitle: PChar);
  451. begin
  452.   TDialog.Init( AParent, ATitle);
  453. end;
  454.  
  455. procedure TAccBalance.SetupWindow;
  456. begin
  457.   TDialog.SetupWindow;
  458.   SetupAccount;
  459.   SetMonthButton( 0);
  460. end;
  461.  
  462. { New methods }
  463.  
  464. procedure TAccBalance.SetupAccount;
  465. var
  466.   Temp : PChar;
  467.   Bal  : real;
  468. begin
  469.   SendDlgItemMsg( 106, bm_SetCheck, 0, 0);
  470.   SendDlgItemMsg( 107, bm_SetCheck, 1, 0);
  471.   GoBack := TRUE;
  472.  
  473.   GetMem( Temp, 20);
  474.   StrCopy( Temp, GAccNum);
  475.   SetDlgItemText( HWindow, 101, Temp);
  476.   Bal := GetBalance( Temp);
  477.   Str( Bal:0:2, PStr);
  478.   StrPCopy( Temp, PStr);
  479.   SetDlgItemText( HWindow, 102, Temp);
  480.   FreeMem( Temp, 20);
  481. end;
  482.  
  483. procedure TAccBalance.SetMonthButton( M: integer);
  484. var
  485.   D, W: word;
  486.   Mo: array[0..10] of char;
  487. begin
  488.   if M = 0 then GetDate( GYearN, GMonthN, D, W);
  489.   StrPCopy( Mo, Month[ GMonthN]);
  490.   SetDlgItemText( HWindow, 105, Mo);
  491. end;
  492.  
  493. function TAccBalance.GetBalance( T: PChar): real;
  494. begin
  495.   reset( AccF);
  496.   repeat
  497.     read( AccF, GAccRec);
  498.   until ( FilePos( AccF) = FileSize( AccF)) or ( StrComp( T, GAccRec.AccNum) = 0);
  499.   if StrComp( T, GAccRec.AccNum) = 0 then
  500.     GetBalance := GAccRec.AccBal
  501.   else
  502.     GetBalance := 0.0;
  503.   close( AccF);
  504. end;
  505.  
  506. procedure TAccBalance.Handle105( var Msg: TMessage);
  507. var
  508.   Mo3 : string[3];
  509.   Yr : string[4];
  510.   Cred,
  511.   Deb: real;
  512.   Temp: PChar;
  513. begin
  514.   if SendDlgItemMsg( 106, bm_GetCheck, 0, 0) <> 0 then GoBack := FALSE
  515.   else GoBack := TRUE;
  516.   Mo3 := copy( Month[ GMonthN], 1, 3);
  517.   str( GYearN, Yr);
  518.   delete( Yr, 1, 2);
  519.   assign( ActF, Mo3 + Yr + '.DTA');
  520.   {$I-}
  521.   reset( ActF);
  522.   {$I+}
  523.   if ioresult = 0 then
  524.   begin
  525.     Cred := 0.0;
  526.     Deb := 0.0;
  527.     repeat
  528.       read( ActF, GActRec);
  529.       if StrComp( GActRec.AccNum, GAccNum) = 0 then
  530.       begin
  531.         if GActRec.Credit <> 0.0 then Cred := Cred + GActRec.Credit
  532.         else if GActRec.Debit <> 0.0 then Deb := Deb + GActRec.Debit;
  533.       end;
  534.     until FilePos( ActF) = FileSize( ActF);
  535.     close( ActF);
  536.     if GoBack then dec( GMonthN)
  537.     else inc( GMonthN);
  538.     if GMonthN < 1 then
  539.     begin
  540.       Dec( GYearN);
  541.       GMonthN := 12;
  542.     end;
  543.     if GMonthN > 12 then
  544.     begin
  545.       inc( GYearN);
  546.       GMonthN := 1;
  547.     end;
  548.     GetMem( Temp, 10);
  549.     str( Cred:0:2, PStr);
  550.     StrPCopy( Temp, PStr);
  551.     SetDlgItemText( HWindow, 103, Temp);
  552.     str( Deb:0:2, PStr);
  553.     StrPCopy( Temp, PStr);
  554.     SetDlgItemText( HWindow, 104, Temp);
  555.     FreeMem( Temp, 10);
  556.     SetMonthButton( 1);
  557.   end
  558.   else
  559.   begin
  560.     MessageBox( HWindow, 'No more transaction files', 'Account Balances',
  561.                 mb_IconStop or mb_OK);
  562.     if GoBack then inc( GMonthN)
  563.     else dec( GMonthN);
  564.     if GMonthN < 1 then
  565.     begin
  566.       Dec( GYearN);
  567.       GMonthN := 12;
  568.     end;
  569.     if GMonthN > 12 then
  570.     begin
  571.       inc( GYearN);
  572.       GMonthN := 1;
  573.     end;
  574.     SetMonthButton( 1);
  575.     SetDlgItemText( HWindow, 103, '');
  576.     SetDlgItemText( HWindow, 104, '');
  577.   end;
  578. end;
  579.  
  580. end.